home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 38
/
Aminet 38 (2000)(Schatztruhe)[!][Aug 2000].iso
/
PPaint
/
ColorType
/
Rexx
/
AntiAliasFont.ctrx
next >
Wrap
Text File
|
1996-05-05
|
5KB
|
143 lines
/* ColorType Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
/* $VER: AntiAliasFont.ctrx 1.0 */
/**
This script creates an anti-aliased font having the specified size.
Different shades of gray are used to give the illusion of a higher
resolution.
For best results, it is recommended to either select an outline (vector)
font, such as Amiga fonts beginning with "CG" (Compugraphic fonts), or
to select a bitmapped font for which a larger size (exactly 2, 3 or 4
times the destination size, as indicated below) exists.
The settings requester, which is displayed after the font requester,
includes the following parameters:
Font: "Black on White" (white background, black characters), or "White on
Black" (black background, white characters).
Anti-Alias: "Low" (4 colors - scale factor 2), "Medium" (8 colors - scale
factor 3) or "High" (16 colors - scale factor 4). The higher the value of
this setting, the more memory is required.
For example, if the "High" option is selected for a font size of 8, this
program opens a monochrome font 4 times larger (i.e. size 32), and then
scales it down to size 8 using 16 shades of gray to create smoother outlines.
*/
IF ARG(1, EXISTS) THEN
PARSE ARG CTPORT
ELSE
CTPORT = 'COLORTYPE'
IF ~SHOW('P', CTPORT) THEN DO
IF EXISTS('ColorType:ColorType') THEN DO
ADDRESS COMMAND 'Run >NIL: ColorType:ColorType'
DO 30 WHILE ~SHOW('P',CTPORT)
ADDRESS COMMAND 'Wait >NIL: 1 SEC'
END
END
ELSE DO
SAY "ColorType could not be loaded."
EXIT 10
END
END
IF ~SHOW('P', CTPORT) THEN DO
SAY 'ColorType Rexx port could not be opened.'
EXIT 10
END
ADDRESS VALUE CTPORT
OPTIONS RESULTS
OPTIONS FAILAT 10000
LockGUI
RequestFont '"Select the Font"'
IF RC = 0 THEN DO
PARSE VALUE RESULT WITH '"' fontpath '" "' fontname '"' fontsize fontstyle .
Request '"Settings" ' ||,
'"CYCLE = Font:, 2, 0, ""Black on White"", ""White on Black"" ' ||,
' CYCLE = Anti-Alias:, 3, 0, Low, Medium, High "'
IF RC = 0 THEN DO
ptype = RESULT.1
scale = RESULT.2 + 2
colnum = 2 ** scale
bigsize = fontsize * scale
FontExists '"'fontpath'" "'fontname'"' bigsize fontstyle
IF RC ~= 0 THEN DO
RequestResponse 'PROMPT "The specified font/size_cannot give the best results"'
END
IF RC = 0 THEN DO
NewFont
IF RC = 0 THEN DO
errcode = 0
LoadFont FORCE '"'fontpath'" "'fontname'"' bigsize fontstyle
IF RC = 0 THEN DO
tmpfname = 'T:ctrx_plt.'PRAGMA('ID')
IF OPEN(pltfile, tmpfname, 'W') THEN DO
IF ptype THEN DO /* white on black */
IF colnum = 4 THEN
WRITECH(pltfile, '464F524D 00000034 494C424D 424D4844 00000014 00000000 00000000 02020180 00000000 00000000 434D4150 0000000C 000000FF FFFFAAAA AA555555'X)
ELSE IF colnum = 8 THEN
WRITECH(pltfile, '464F524D 00000040 494C424D 424D4844 00000014 00000000 00000000 03020180 00000000 00000000 434D4150 00000018 000000FF FFFFCACA CAAAAAAA 9292926D 6D6D4949 49242424'X)
ELSE
WRITECH(pltfile, '464F524D 00000058 494C424D 424D4844 00000014 00000000 00000000 04020180 00000000 00000000 434D4150 00000030 000000FF FFFFEEEE EEDDDDDD CCCCCCBB BBBBAAAA AA999999 88888877 77776666 66555555 44444433 33332222 22111111'X)
END
ELSE DO /* black on white */
IF colnum = 4 THEN
WRITECH(pltfile, '464F524D 00000034 494C424D 424D4844 00000014 00000000 00000000 02020180 00000000 00000000 434D4150 0000000C FFFFFF00 00005555 55AAAAAA'X)
ELSE IF colnum = 8 THEN
WRITECH(pltfile, '464F524D 00000040 494C424D 424D4844 00000014 00000000 00000000 03020180 00000000 00000000 434D4150 00000018 FFFFFF00 00002424 24494949 6D6D6D92 9292AAAA AACACACA'X)
ELSE
WRITECH(pltfile, '464F524D 00000058 494C424D 424D4844 00000014 00000000 00000000 04020180 00000000 00000000 434D4150 00000030 FFFFFF00 00001111 11222222 33333344 44445555 55666666 77777788 88889999 99AAAAAA BBBBBBCC CCCCDDDD DDEEEEEE'X)
END
CALL CLOSE(pltfile)
END
Set 'FORCE "COLORS='colnum'" "PALETTE=""'tmpfname'"" "'
IF RC = 0 THEN DO
Get 'XMAX'
xmax = RESULT % scale
Get 'STRETCH'
sflags = X2D(SUBSTR(RESULT, 3))
nsflags = C2D(BITSET(D2C(sflags),2)) /* set "Color Average" bit */
Set 'FORCE STRETCH "XMAX='xmax'" "YMAX='fontsize'" "STRETCH='nsflags'"'
IF RC ~= 0 THEN DO
errcode = RC
IF RC = 5 THEN
errmess = 'User abort during font resize.'
ELSE
errmess = 'Error 'RC' during font resize.'
END
Set '"STRETCH='sflags'"'
END
ELSE DO
errcode = RC
errmess = 'Color environment_cannot be set:_error 'RC'.'
END
ADDRESS COMMAND 'Delete >NIL: 'tmpfname
END
ELSE DO
errcode = RC
IF RC = 5 THEN
errmess = 'User abort during load.'
ELSE
errmess = 'Error 'RC' during load.'
END
IF errcode > 0 THEN DO
SAY errmess
RequestNotify 'PROMPT="'errmess'"'
END
END
END
END
END
UnlockGUI